perm filename MIXSCR.OLF[SCR,LCS] blob
sn#369207 filedate 1978-07-21 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 C***** MIXES AND LINKS FILES PUT OUT BY 'SCORE' *******
C00010 ENDMK
Cā;
C***** MIXES AND LINKS FILES PUT OUT BY 'SCORE' *******
C***** ALL FILES MUST HAVE THE .SCR EXTENSION *****
C***** LOAD WITH RENAM.FAI
C***** USE 'R LOADER'. INCLUDE '/LLIB40.OLD[1,3]'. OTHERWISE THERE
C WILL BE READ ERRORS DUE TO BUGS IN CURRENT LIB40 3/77 *******
COMMON /VV/Q(19),R(19),KL,N1,N2,N3,J,K,L,M,P1,PX,A,B,C,D,IBL
COMMON /LNK/ NK,NZ(10),IP
DATA IBL/' '/
TYPE 24
NK=0
LX=0
ACCEPT 2,K,IP
IF(K.EQ.'L')LX=-1
200 TYPE 20
ACCEPT 2,N1
IF(N1.EQ.IBL)GO TO 200
IF(FINDIT(N1))CALL NOTFND(N1)
C DO A LOOKUP FIRST OF ALL
CC CALL RENAMX(N1,'SCR','$$$$1','DAT')
201 TYPE 22
ACCEPT 2,N2
IF(N2.EQ.IBL.OR.N2.EQ.N1)GO TO 201
IF(FINDIT(N2))CALL NOTFND(N2)
IF(LX.EQ.0)GO TO 202
1000 TYPE 41
ACCEPT 2,K
IF(K.EQ.IBL)GO TO 202
C TAKES UP TO 2+10 FILES.
NK=NK+1
NZ(NK)=K
IF(NK.LT.10)GO TO 1000
202 TYPE 23
ACCEPT 2,N3
IF(N3.EQ.IBL)GO TO 202
CALL OFILE(1,N3)
TYPE 300
300 FORMAT(' ****** CAUTION ******'/
1' ****** NEVER STOP THIS PROGRAM WHILE IT IS WORKING ******'/)
CALL RENAMX(N1,'SCR',N1,'DAT')
CALL RENAMX(N2,'SCR',N2,'DAT')
CALL IFILE(21,N1)
CALL IFILE(22,N2)
CC CALL RENAMX(N1,'SCR','$$$$1','DAT')
CC CALL RENAMX(N2,'SCR','$$$$2','DAT')
CC CALL IFILE(21,'$$$$1')
CC CALL IFILE(22,'$$$$2')
TYPE 25
IF(LX.EQ.0)GO TO 25
CALL LINK
GO TO 204
25 FORMAT(/' WORKING'/)
DO 1 K=1,3
READ(21,2)Q
WRITE(1,2)Q
1 READ(22,2)Q
C READS FIRST 3 LINES
CALL CHECK(N,Q,P1,21)
CALL CHECK(M,R,PX,22)
CATCHES INSERTED LINES.
6 IF(PX.LT.P1)GO TO 5
CALL RDWRT(N,P1,Q,21)
IF(KL)10,6,6
5 CALL RDWRT(M,PX,R,22)
IF(KL.EQ.0)GO TO 6
11 PX=10000
GO TO 13
10 P1=10000
13 IF(P1.NE.10000.OR.M.NE.N)GO TO 6
CC13 IF(P1.NE.10000.AND.M.NE.N)GO TO 6
12 WRITE(1,7)
REWIND 21
REWIND 22
CALL RENAMX(N1,'DAT',N1,'SCR')
CALL RENAMX(N2,'DAT',N2,'SCR')
CC CALL RENAMX('$$$$1','DAT',N1,'SCR')
CC CALL RENAMX('$$$$2','DAT',N2,'SCR')
204 END FILE 1
CALL RENAM(N3,'DAT',N3,'SCR')
TYPE 203,N3
CALL EXIT
203 FORMAT(/' ****** MIX FILE NAME = ',A5,'.SCR')
2 FORMAT(19A5)
7 FORMAT(' FINISH;')
24 FORMAT(' MIXES OR LINKS SCORE LISTS.'/
1' USES ".SCR" EXTENSIONS ONLY!!! '/
1' BE SURE ALL HIGHER PARAMS PRINT EACH TIME.'
1//' L = LINK, <CR> = MIX '$)
41 FORMAT(' TYPE NEXT FILE NAME OR <CR> '$)
20 FORMAT(' TYPE FILE 1 (WITHOUT EXT.) '$)
22 FORMAT(/' TYPE FILE 2 '$)
23 FORMAT(/' TYPE OUTPUT NAME '$)
END
SUBROUTINE CHECK(N,Q,P1,J)
COMMON /VV/QQ(19),RR(19),KL,N1,N2,N3,JJ,KK,L,M,P,PX,LL,K,IBL
DIMENSION Q(19),AA(50)
DATA J1/4/,J2/9/,J3/18/
C J1,J2,J3 ARE POINTERS TO POS. OF DOTS IN P1,P2
KL=0
33 READ(J,30,END=100)L,N,K,Q,AA
IF(Q(J1).NE.' ')GO TO 32
IF(Q(J2).NE.'.')GO TO 32
IF(Q(J3).EQ.'.')GO TO 31
CATCHES INSERTED LINES.
32 REREAD 44,L,N,Q
IF(N.EQ.'FINIS')KL=-1
CALL SHORT(Q,N)
CC TYPE 44,L,N,(Q(LL),LL=1,K)
IF(KL)RETURN
CC WRITE(1,44)L,N,(Q(LL),LL=1,K)
GO TO 33
100 PAUSE 'DIED IN SUBR CHECK'
31 REREAD 4,L,N,P1
REREAD 44,L,N,Q
30 FORMAT(72A1)
4 FORMAT(A1,A5,F)
44 FORMAT(A1,20A5)
END
SUBROUTINE SHORT(Q,N)
COMMON /VV/QQ(19),RR(19),KL,N1,N2,N3,JJ,KK,L,M,P,PX,LL,K,A,B,IBL
COMMON /LNK/ NK,NZ(10),IP
DIMENSION Q(1),QV(30)
DO 1 K=19,1,-1
1 IF(Q(K).NE.' ')GO TO 2
2 IF(IP.NE.IBL)TYPE 44,L,N,(Q(LL),LL=1,K)
IF(KL)RETURN
REREAD 44,L,N,(QV(LL),LL=1,K)
3 WRITE(1,44)L,N,(QV(LL),LL=1,K)
44 FORMAT(A1,20A5)
END
SUBROUTINE RDWRT(I,P,R,J)
COMMON /VV/Q(19),RR(19),KL,N1,N2,N3,JJ,KK,L,M,P1,PX,LL,K,IBL
DIMENSION R(19)
KL=0
CALL SHORT(R,I)
CC WRITE(1,44)L,I,(R(N),N=1,K)
CC TYPE 44,L,I,(R(N),N=1,K)
1 READ (J,44,END=100)L,I,R
CXX REREAD 44,L,I,R
CALL SHORT(R,I)
CC WRITE(1,44)L,I,(R(N),N=1,K)
CC TYPE 44,L,I,(R(N),N=1,K)
IF(I.NE.'PRINT')GO TO 1
2 CALL CHECK(I,R,P,J)
RETURN
44 FORMAT(A1,20A5)
100 PAUSE 'DIED IN SUBR RDWRT'
END
SUBROUTINE LINK
COMMON /VV/Q(19),RR(19),KL,N1,N2,N3,JJ,KK,L,M,P1,PX,LL,K,IBL
COMMON /LNK/ NK,NZ(10),IP
44 FORMAT(A1,20A5)
KL=0
JJ=0
J=21
1 READ(J,44)L,LL,Q
IF(LL.EQ.'FINIS')GO TO 2
4 CALL SHORT(Q,LL)
IF(JJ.GT.NK)RETURN
GO TO 1
2 IF(J.NE.21)GO TO 3
REWIND 21
CALL RENAMX(N1,'DAT',N1,'SCR')
CC CALL RENAMX('$$$$1','DAT',N1,'SCR')
J=J+1
GO TO 1
3 REWIND 22
IF(JJ.NE.0)GO TO 6
CALL RENAMX(N2,'DAT',N2,'SCR')
CC CALL RENAMX('$$$$2','DAT',N2,'SCR')
GO TO 5
6 CALL RENAMX(NZ(JJ),'DAT',NZ(JJ),'SCR')
CC6 CALL RENAMX('$$$$2','DAT',NZ(JJ),'SCR'
5 JJ=JJ+1
IF(JJ.GT.NK)GO TO 4
CALL RENAMX(NZ(JJ),'SCR',NZ(JJ),'DAT')
CALL IFILE(22,NZ(JJ))
CC CALL RENAMX(NZ(JJ),'SCR','$$$$2','DAT')
CC CALL IFILE(22,'$$$$2')
GO TO 1
END
SUBROUTINE RENAMX(J,K,L,M)
CALL RENAM(J,K,L,M)
TYPE 1,J,K,L,M
1 FORMAT(' (RENAME -- ',A5,'.',A3,' CHANGED TO -- ',A5,'.',A3,')')
END
SUBROUTINE NOTFND(NM)
TYPE 1,NM
CALL EXIT
1 FORMAT(' ******* FILE ',A5,'.SCR NOT FOUND *****')
END